{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Vote.Internal.Entity where

import Control.Lens (makeLenses, (.~), (?~), (^.))
import Data.Aeson (KeyValue (..), ToJSON (..), Value, object)
import Data.Aeson qualified as A
import Data.Aeson.TH (deriveJSON)
import Data.HashMap.Strict.InsOrd (fromList)
import Data.OpenApi (HasExample (..), HasProperties (..), HasRequired (..), HasTitle (..), HasType (..), OpenApiType (..), ToSchema, declareSchemaRef, genericDeclareNamedSchema)
import Data.OpenApi qualified as O
import Data.OpenApi.Internal.Schema (named)
import Data.Profunctor.Product
import Data.Time (UTCTime)
import Numeric.Natural (Natural)
import Opaleye ( SqlInt8, Field, SqlText, SqlTimestamptz, FieldNullable, SqlInt4 )
import Protolude hiding (Rep)
import Vote.Internal.Aeson (schemaOptions, toJSONOptions)
import Vote.Internal.Model (SceneType)
import Vote.Internal.Util (trimPrefixName_)
import Tedious.Type (tt)

--

data LoginForm = LoginForm
  { _loginFormUsername :: Text,
    _loginFormPassword :: Text
  }
  deriving (Show, Eq, Generic)

deriveJSON (toJSONOptions {A.fieldLabelModifier = trimPrefixName_ ''LoginForm}) ''LoginForm

instance ToSchema LoginForm where
  declareNamedSchema = genericDeclareNamedSchema (schemaOptions {O.fieldLabelModifier = trimPrefixName_ ''LoginForm})

makeLenses ''LoginForm

newtype SysUserAuthed = SysUserAuthed
  { _sysUserAuthedName :: Text
  }
  deriving (Show, Eq, Generic)

deriveJSON (toJSONOptions {A.fieldLabelModifier = trimPrefixName_ ''SysUserAuthed}) ''SysUserAuthed

instance ToSchema SysUserAuthed where
  declareNamedSchema = genericDeclareNamedSchema (schemaOptions {O.fieldLabelModifier = trimPrefixName_ ''SysUserAuthed})

makeLenses ''SysUserAuthed

sysUserAdmin :: SysUserAuthed
sysUserAdmin = SysUserAuthed "admin"

--

data PageD a = PageD
  { _pageDIndex :: Natural,
    _pageDSize :: Natural,
    _pageDTotal :: Natural,
    _pageDData :: a
  }

deriving instance (Show a) => Show (PageD a)

deriving instance (Eq a) => Eq (PageD a)

deriving instance Generic (PageD a)

deriveJSON (toJSONOptions {A.fieldLabelModifier = trimPrefixName_ ''PageD}) ''PageD

instance (ToSchema a) => ToSchema (PageD a) where
  declareNamedSchema = genericDeclareNamedSchema (schemaOptions {O.fieldLabelModifier = trimPrefixName_ ''PageD})

makeLenses ''PageD

data Page = Page
  { _pageIndex :: Natural,
    _pageSize :: Natural
  }
  deriving (Show, Eq, Generic)

deriveJSON (toJSONOptions {A.fieldLabelModifier = trimPrefixName_ ''Page}) ''Page

instance ToSchema Page where
  declareNamedSchema _ = do
    natSchema <- declareSchemaRef (Proxy :: Proxy Natural)
    return $
      named "Page" $
        mempty
          & type_ ?~ OpenApiObject
          & properties
            .~ fromList
              [ ("index", natSchema <&> title ?~ "页码"),
                ("size", natSchema <&> title ?~ "每页条数")
              ]
          & required .~ ["index", "size"]
          & example ?~ toJSON (Page 1 10)

makeLenses ''Page

fillPage :: Page -> Int -> a -> PageD a
fillPage meta total v =
  PageD
    { _pageDIndex = meta ^. pageIndex,
      _pageDSize = meta ^. pageSize,
      _pageDTotal = fromIntegral total,
      _pageDData = v
    }

--

data Err = Err
  { _errCode :: Natural,
    _errMsg :: Text
  }
  deriving (Show, Eq, Generic)

deriveJSON (toJSONOptions {A.fieldLabelModifier = trimPrefixName_ ''Err}) ''Err

instance ToSchema Err where
  declareNamedSchema = genericDeclareNamedSchema schemaOptions {O.fieldLabelModifier = trimPrefixName_ ''Err}

instance Exception Err

makeLenses ''Err

--

data Rep a = Rep
  { _repCode :: Natural,
    _repMsg :: Text,
    _repData :: Maybe a
  }
  deriving (Show, Eq, Generic)

instance (ToJSON a) => ToJSON (Rep a) where
  toJSON :: Rep a -> Value
  toJSON (Rep c m Nothing) = object ["code" .= c, "message" .= m]
  toJSON (Rep c m (Just d)) = object ["code" .= c, "message" .= m, "data" .= toJSON d]

instance (ToSchema a) => ToSchema (Rep a) where
  declareNamedSchema = genericDeclareNamedSchema schemaOptions {O.fieldLabelModifier = trimPrefixName_ ''Rep}

makeLenses ''Rep

repOk :: Rep a
repOk = Rep 0 "ok" Nothing

rep :: a -> Rep a
rep d = Rep 0 "ok" (Just d)

repErr :: Natural -> Text -> Rep a
repErr c m = Rep c m Nothing

repErr' :: Err -> Rep a
repErr' e = Rep (e ^. errCode) (e ^. errMsg) Nothing

repErrNotSupport :: Rep a
repErrNotSupport = repErr 500 "not supported yet"

--

data Nullable a = SetNull | NotNull a deriving (Show, Eq, Generic)

deriveJSON toJSONOptions ''Nullable

--

[tt|
Scene deriving Eq Show Generic ToJSON FromJSON ToSchema
  id Int64 (Maybe (Field SqlInt8), Field SqlInt8) SceneGet SceneUpd
  type Text (Field SqlText) SceneGet
  typeEnum SceneType SceneAdd
  info Text (Field SqlText) SceneGet SceneAdd SceneUpd?
  timeOpen UTCTime? ("time_open", FieldNullable SqlTimestamptz) SceneGet SceneAdd SceneUpd?
  timeShut UTCTime? ("time_shut", FieldNullable SqlTimestamptz) SceneGet SceneAdd SceneUpd?
  markDeno Int ("mark_deno", Field SqlInt4) SceneGet SceneAdd?

Actor deriving Eq Show Generic ToJSON FromJSON ToSchema
  id Int64 (Maybe (Field SqlInt8), Field SqlInt8) ActorUpd
  sceneId Int64 (Field SqlInt8) ActorAdd
  info Text (Field SqlText) ActorAdd ActorUpd?

Voter deriving Eq Show Generic ToJSON FromJSON ToSchema
  id Int64 (Maybe (Field SqlInt8), Field SqlInt8) VoterUpd
  sceneId Int64 (Field SqlInt8) VoterAdd
  info Text (Field SqlText) VoterAdd VoterUpd?
  factorNume Int ("factor_nume", Field SqlInt4) VoterAdd
  factorDeno Int ("factor_deno", Field SqlInt4) VoterAdd

Action deriving Eq Show Generic ToJSON FromJSON ToSchema
  id Int64 (Maybe (Field SqlInt8), Field SqlInt8)
  sceneId Int64 ("scene_id", Field SqlInt8) ActionAdd
  actorId Int64 ("actor_id", Field SqlInt8) ActionAdd
  voterId Int64 ("voter_id", Field SqlInt8) ActionAdd
  markNume Int ("mark_nume", Field SqlInt4) ActionAdd
|]
